home *** CD-ROM | disk | FTP | other *** search
- unit CaptureU;
-
- interface
-
- uses
- WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ExtCtrls;
-
- type
- TForm1 = class(TForm)
- Img: TImage;
- SaveDlg: TSaveDialog;
- LoadDlg: TOpenDialog;
- Panel1: TPanel;
- Button1: TButton;
- Button2: TButton;
- Button3: TButton;
- procedure Button1Click(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- procedure Button3Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
- var
- Form1: TForm1;
-
- implementation
-
- {$R *.DFM}
-
- procedure TForm1.Button1Click(Sender: TObject);
- const
- NumColors = 256;
- var
- R: TRect;
- C: TCanvas;
- LP: PLogPalette;
- Size: Integer;
- begin
- R := Img.BoundsRect;
- C := TCanvas.Create;
- C.Handle := GetDC(HWnd_Desktop);
- try
- Img.Canvas.CopyRect(R, C, R);
- Size := SizeOf(TLogPalette) + (Pred(NumColors) * SizeOf(TPaletteEntry));
- LP := AllocMem(Size);
- try
- LP^.palVersion := $300;
- LP^.palNumEntries := NumColors;
- GetSystemPaletteEntries(C.Handle, 0, NumColors, LP^.palPalEntry);
- Img.Picture.Bitmap.Palette := CreatePalette(LP^);
- finally
- FreeMem(LP, Size);
- end
- finally
- ReleaseDC(HWnd_Desktop, C.Handle);
- C.Free;
- end;
- end;
-
- procedure TForm1.Button2Click(Sender: TObject);
- begin
- if SaveDlg.Execute then
- Img.Picture.Bitmap.SaveToFile(SaveDlg.FileName)
- end;
-
- procedure TForm1.Button3Click(Sender: TObject);
- begin
- if LoadDlg.Execute then
- Img.Picture.Bitmap.LoadFromFile(LoadDlg.FileName)
- end;
-
- end.
-